unit uSBD_Crypto_CryptographicLibrary;
{
Copyright 2009 Sean B. Durkin

This file is part of SBD Crypto Library.
SBD Crypto Library is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

SBD Crypto Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the Lesser GNU General Public License
along with SBD Crypto Library.  If not, see <http://www.gnu.org/licenses/>.
}
interface
uses Classes, uSBD_Crypto_BaseNonVisualComponent, uSBD_Crypto_StreamCipher,
     uSBD_Crypto_BlockCipher, contnrs, uSBD_Crypto_Hash;

type

// The following type is for internal use only.
TCryptoLibStringRef = (cStreamId, sStreamName, cBlockId, cBlockName,
                       cChainId, cChainName, cHashId, cHashName);

TCryptographicLibrary = class;
TBurnProc = procedure (Sender: TCryptographicLibrary) of object;
TTransformBlockProc = procedure( Sender: TCryptographicLibrary;
  Plaintext{in}, Ciphertext{out}: TMemoryStream) of object;

TCustomChainMode = class( TPersistent)
  strict private
  published
  end;

TCryptographicLibrary = class( TSBD_Crypto_BaseNonVisualComponent)
  private
    FStreamCiphers: IInterfaceList; // of IStreamCipher
    FBlockCiphers : IInterfaceList; // of IBlockCipher
    FChainModes   : IInterfaceList; // of IBlockChainingModel
    FHashes       : IInterfaceList; // of IHash
    FStreamCiphers_ByProgId: TStrings;
    FStreamCiphers_ByDisplayName: TStrings;
    FBlockCiphers_ByProgId: TStrings;
    FBlockCiphers_ByDisplayName: TStrings;
    FChainModes_ByProgId: TStrings;
    FChainModes_ByDisplayName: TStrings;
    FHashs_ByProgId: TStrings;
    FHashs_ByDisplayName: TStrings;
    FCustomChainMode: TCustomChainMode;

    function  GetStreamCiphers_ByProgId: TStrings;
    function  GetStreamCiphers_ByDisplayName: TStrings;
    function  GetStreamCipherDisplayNames( const ProgIdx: string): string;

    function  GetBlockCiphers_ByProgId: TStrings;
    function  GetBlockCiphers_ByDisplayName: TStrings;
    function  GetBlockCipherDisplayNames( const ProgIdx: string): string;

    function  GetChainModes_ByProgId: TStrings;
    function  GetChainModes_ByDisplayName: TStrings;
    function  GetChainModesDisplayNames( const ProgIdx: string): string;

    function  GetHashs_ByProgId: TStrings;
    function  GetHashs_ByDisplayName: TStrings;
    function  GetHashDisplayNames( const ProgIdx: string): string;

    function  MeasureDepthUp  ( MeasureLimit: integer): integer;
    function  MeasureDepthDown( MeasureLimit: integer): integer;

  protected
    FAffliateParent: TCryptographicLibrary;
    FAfflicates: TObjectList; // of children TCryptographicLibrary.

    procedure SetAffliateParent( Value: TCryptographicLibrary);
    procedure Notification(
      AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create( AOwner: TComponent); override;
    destructor  Destroy; override;

    function  StreamCipherIntfc( const ProgIdx: string): IStreamCipher;
    procedure RegisterStreamCipher  ( const Registrant: IStreamCipher);
    procedure DeregisterStreamCipher( const Registrant: IStreamCipher);

    function  BlockCipherIntfc( const ProgIdx: string): IBlockCipher;
    procedure RegisterBlockCipher  ( const Registrant: IBlockCipher);
    procedure DeregisterBlockCipher( const Registrant: IBlockCipher);

    function  BlockChainingModelIntfc( const ProgIdx: string): IBlockChainingModel;
    procedure RegisterBlockChainingModel  ( const Registrant: IBlockChainingModel);
    procedure DeregisterBlockChainingModel( const Registrant: IBlockChainingModel);

    function  HashIntfc( const ProgIdx: string): IHash;
    procedure RegisterHash  ( const Registrant: IHash);
    procedure DeregisterHash( const Registrant: IHash);

    property StreamCiphers_ByProgId: TStrings            read GetStreamCiphers_ByProgId;
    property StreamCiphers_ByDisplayName: TStrings       read GetStreamCiphers_ByDisplayName;
    property StreamCipherDisplayNames[ const ProgIdx: string]: string
                                                         read GetStreamCipherDisplayNames;

    property BlockCiphers_ByProgId: TStrings             read GetBlockCiphers_ByProgId;
    property BlockCiphers_ByDisplayName: TStrings        read GetBlockCiphers_ByDisplayName;
    property BlockCipherDisplayNames[ const ProgIdx: string]: string
                                                         read GetBlockCipherDisplayNames;

    property ChainModes_ByProgId: TStrings               read GetChainModes_ByProgId;
    property ChainModes_ByDisplayName: TStrings          read GetChainModes_ByDisplayName;
    property ChainModesDisplayNames[ const ProgIdx: string]: string
                                                         read GetChainModesDisplayNames;

    property Hashs_ByProgId: TStrings                    read GetHashs_ByProgId;
    property Hashs_ByDisplayName: TStrings               read GetHashs_ByDisplayName;
    property HashDisplayNames[ const ProgIdx: string]: string
                                                         read GetHashDisplayNames;
  published
    property AffiliatedLibrary: TCryptographicLibrary
                      read  FAffliateParent
                      write SetAffliateParent;
                      
    property CustomChainMode: TCustomChainMode read     FCustomChainMode;
  end;



implementation











uses
  Math, SysUtils,

  // Chain modes:
  uSBD_Crypto_ECB,         uSBD_Crypto_CBC,      uSBD_Crypto_PCBC,
  uSBD_Crypto_CFB_Block,   uSBD_Crypto_CFB_8Bit, uSBD_Crypto_OFB,
  uSBD_Crypto_CTR;


type
TCryptLibStrings = class( TStrings)
  private
    FReference: TCryptoLibStringRef;
    FLib: TCryptographicLibrary;
    FisDestroying: boolean;

  protected
    function Get( Index: Integer): string; override;
    function GetCount: Integer; override;

  public
    constructor Create( Ref1: TCryptoLibStringRef;
                        Lib1: TCryptographicLibrary);
    destructor Destroy; override;

    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
end;



{ TCryptographicLibrary }

constructor TCryptographicLibrary.Create( AOwner: TComponent);
var
  j: TCryptoLibStringRef;

begin
inherited Create( AOwner);
FChainModes     := TInterfaceList.Create;
FBlockCiphers   := TInterfaceList.Create;
FStreamCiphers  := TInterfaceList.Create;
FHashes         := TInterfaceList.Create;
for j := Low( TCryptoLibStringRef) to High( TCryptoLibStringRef) do
  TCryptLibStrings.Create( j, self);
FAffliateParent := nil;
FAfflicates := TObjectList.Create( False); // of children TCryptographicLibrary.

FChainModes.Add( TECB.Create);
FChainModes.Add( TCBC.Create);
FChainModes.Add( TPCBC.Create);
FChainModes.Add( TCFB_Block.Create);
FChainModes.Add( TCFB_8Bit.Create);
FChainModes.Add( TOFB.Create);
FChainModes.Add( TCTR.Create);

end;


destructor TCryptographicLibrary.Destroy;
begin
SetAffliateParent( nil);
FStreamCiphers_ByProgId.Free;
FStreamCiphers_ByDisplayName.Free;
FBlockCiphers_ByProgId.Free;
FBlockCiphers_ByDisplayName.Free;
FChainModes_ByProgId.Free;
FChainModes_ByDisplayName.Free;
FHashs_ByProgId.Free;
FHashs_ByDisplayName.Free;
inherited;
FAfflicates.Free
end;


function TCryptographicLibrary.BlockChainingModelIntfc(
  const ProgIdx: string): IBlockChainingModel;
var
  Idx, j: integer;
begin
Idx := ChainModes_ByProgId.IndexOf( ProgIdx);
if Idx <> -1 then
    result := FChainModes[ Idx] as IBlockChainingModel
  else
    result := nil;
if assigned( result) then exit;
for j := 0 to FAfflicates.Count - 1 do
  begin
  result := (FAfflicates[j] as TCryptographicLibrary)
    .BlockChainingModelIntfc( ProgIdx);
  if assigned( result) then break
  end
end;



function TCryptographicLibrary.BlockCipherIntfc(
  const ProgIdx: string): IBlockCipher;
var
  Idx, j: integer;
begin
Idx := BlockCiphers_ByProgId.IndexOf( ProgIdx);
if Idx <> -1 then
    result := FBlockCiphers[ Idx] as IBlockCipher
  else
    result := nil;
if assigned( result) then exit;
for j := 0 to FAfflicates.Count - 1 do
  begin
  result := (FAfflicates[j] as TCryptographicLibrary)
    .BlockCipherIntfc( ProgIdx);
  if assigned( result) then break
  end
end;



procedure TCryptographicLibrary.DeregisterBlockChainingModel(
  const Registrant: IBlockChainingModel);
begin
FChainModes.Remove( Registrant)
end;



procedure TCryptographicLibrary.DeregisterBlockCipher(
  const Registrant: IBlockCipher);
begin
FBlockCiphers.Remove( Registrant)
end;



procedure TCryptographicLibrary.DeregisterHash( const Registrant: IHash);
begin
FHashes.Remove( Registrant)
end;



procedure TCryptographicLibrary.DeregisterStreamCipher(
  const Registrant: IStreamCipher);
begin
FStreamCiphers.Remove( Registrant)
end;


function TCryptographicLibrary.GetBlockCipherDisplayNames(
  const ProgIdx: string): string;
var
  Cipher: IBlockCipher;
begin
Cipher := BlockCipherIntfc( ProgIdx);
if assigned( Cipher) then
    result := Cipher.DisplayName
  else
    result := ''
end;


function TCryptographicLibrary.GetBlockCiphers_ByDisplayName: TStrings;
begin
if not assigned( FBlockCiphers_ByDisplayName) then
  TCryptLibStrings.Create( cBlockName, self);
result := FBlockCiphers_ByDisplayName
end;


function TCryptographicLibrary.GetBlockCiphers_ByProgId: TStrings;
begin
if not assigned( FBlockCiphers_ByProgId) then
  TCryptLibStrings.Create( cBlockId, self);
result := FBlockCiphers_ByProgId
end;




function TCryptographicLibrary.GetChainModesDisplayNames(
  const ProgIdx: string): string;
var
  Cipher: IBlockChainingModel;
begin
Cipher := BlockChainingModelIntfc( ProgIdx);
if assigned( Cipher) then
    result := Cipher.DisplayName
  else
    result := ''
end;



function TCryptographicLibrary.GetChainModes_ByDisplayName: TStrings;
begin
if not assigned( FChainModes_ByDisplayName) then
  TCryptLibStrings.Create( cChainName, self);
result := FChainModes_ByDisplayName
end;



function TCryptographicLibrary.GetChainModes_ByProgId: TStrings;
begin
if not assigned( FChainModes_ByProgId) then
  TCryptLibStrings.Create( cChainId, self);
result := FChainModes_ByProgId
end;



function TCryptographicLibrary.GetHashDisplayNames(
  const ProgIdx: string): string;
var
  Hash: IHash;
begin
Hash := HashIntfc( ProgIdx);
if assigned( Hash) then
    result := Hash.DisplayName
  else
    result := ''
end;



function TCryptographicLibrary.GetHashs_ByDisplayName: TStrings;
begin
if not assigned( FHashs_ByDisplayName) then
  TCryptLibStrings.Create( cHashName, self);
result := FHashs_ByDisplayName
end;



function TCryptographicLibrary.GetHashs_ByProgId: TStrings;
begin
if not assigned( FHashs_ByProgId) then
  TCryptLibStrings.Create( cHashId, self);
result := FHashs_ByProgId
end;


function TCryptographicLibrary.GetStreamCipherDisplayNames(
  const ProgIdx: string): string;
var
  Cipher: IStreamCipher;
begin
Cipher := StreamCipherIntfc( ProgIdx);  
if assigned( Cipher) then
    result := Cipher.DisplayName
  else
    result := ''
end;



function TCryptographicLibrary.GetStreamCiphers_ByDisplayName: TStrings;
begin
if not assigned( FStreamCiphers_ByDisplayName) then
  TCryptLibStrings.Create( sStreamName, self);
result := FStreamCiphers_ByDisplayName
end;



function TCryptographicLibrary.GetStreamCiphers_ByProgId: TStrings;
begin
if not assigned( FStreamCiphers_ByProgId) then
  TCryptLibStrings.Create( cStreamId, self);
result := FStreamCiphers_ByProgId
end;



function TCryptographicLibrary.HashIntfc( const ProgIdx: string): IHash;
var
  Idx, j: integer;
begin
Idx := Hashs_ByProgId.IndexOf( ProgIdx);
if Idx <> -1 then
    result := FHashes[ Idx] as IHash
  else
    result := nil;
if assigned( result) then exit;
for j := 0 to FAfflicates.Count - 1 do
  begin
  result := (FAfflicates[j] as TCryptographicLibrary)
    .HashIntfc( ProgIdx);
  if assigned( result) then break
  end
end;



procedure TCryptographicLibrary.RegisterBlockChainingModel(
  const Registrant: IBlockChainingModel);
var
  Idx: integer;
begin
Idx := FChainModes.IndexOf( Registrant);
if Idx <> -1 then exit;
Idx := ChainModes_ByProgId.IndexOf( Registrant.ProgId);
if Idx <> -1 then
  FChainModes.Delete( Idx);   // Resolve name conflict
FChainModes.Add( Registrant)
end;



procedure TCryptographicLibrary.RegisterBlockCipher(
  const Registrant: IBlockCipher);
var
  Idx: integer;
begin
Idx := FBlockCiphers.IndexOf( Registrant);
if Idx <> -1 then exit;
Idx := BlockCiphers_ByProgId.IndexOf( Registrant.ProgId);
if Idx <> -1 then
  FBlockCiphers.Delete( Idx);   // Resolve name conflict
FBlockCiphers.Add( Registrant)
end;



procedure TCryptographicLibrary.RegisterHash( const Registrant: IHash);
var
  Idx: integer;
begin
Idx := FHashes.IndexOf( Registrant);
if Idx <> -1 then exit;
Idx := Hashs_ByProgId.IndexOf( Registrant.ProgId);
if Idx <> -1 then
  FHashes.Delete( Idx);   // Resolve name conflict
FHashes.Add( Registrant)
end;


procedure TCryptographicLibrary.RegisterStreamCipher(
  const Registrant: IStreamCipher);
var
  Idx: integer;
begin
Idx := FStreamCiphers.IndexOf( Registrant);
if Idx <> -1 then exit;
Idx := StreamCiphers_ByProgId.IndexOf( Registrant.ProgId);
if Idx <> -1 then
  FStreamCiphers.Delete( Idx);   // Resolve name conflict
FStreamCiphers.Add( Registrant)
end;



function TCryptographicLibrary.StreamCipherIntfc(
  const ProgIdx: string): IStreamCipher;
var
  Idx, j: integer;
begin
Idx := StreamCiphers_ByProgId.IndexOf( ProgIdx);
if Idx <> -1 then
    result := FStreamCiphers[ Idx] as IStreamCipher
  else
    result := nil;
if assigned( result) then exit;
for j := 0 to FAfflicates.Count - 1 do
  begin
  result := (FAfflicates[j] as TCryptographicLibrary)
    .StreamCipherIntfc( ProgIdx);
  if assigned( result) then break
  end
end;


function TCryptographicLibrary.MeasureDepthDown( MeasureLimit: integer): integer;
var
  W: TCryptographicLibrary;
  j, M: integer;
begin
result := 0;
for j := 0 to FAfflicates.Count - 1 do
  begin
  W := FAfflicates[j] as TCryptographicLibrary;
  if MeasureLimit > 0 then
      M := W.MeasureDepthDown( MeasureLimit-1)
    else
      M := -1;
  if M = -1 then
    begin
    result := -1;
    break
    end;
  result := Max( result, M + 1)
  end;
end;

function TCryptographicLibrary.MeasureDepthUp( MeasureLimit: integer): integer;
var
  W: TCryptographicLibrary;
begin
result := -1;
W := self;
while assigned( W) do
  begin
  W := W.FAffliateParent;
  Inc( result);
  if result < MeasureLimit then continue;
  result := -1;
  break
  end
end;

const MaxDepth = 10;

procedure TCryptographicLibrary.SetAffliateParent( Value: TCryptographicLibrary);
var
  Depth, DepthDown, DepthDown1, DepthDown2, DepthUp: integer;
  W: TCryptographicLibrary;
  isCircular: boolean;
  j: integer;
begin
if FAffliateParent = Value then exit;

if assigned( Value) then
  begin
  DepthDown1 := MeasureDepthDown( MaxDepth);
  if assigned( Value) then
      DepthDown2 := Value.MeasureDepthDown( MaxDepth)
    else
      DepthDown2 := 0;
  if DepthDown2 <> -1 then
    Inc( DepthDown2);
  if (DepthDown1 <> -1) and (DepthDown2 <> -1) then
      DepthDown := Max( DepthDown1, DepthDown2)
    else
      DepthDown := -1;
  DepthUp := MeasureDepthUp( MaxDepth);
  if (DepthDown <> -1) and (DepthUp <> -1) then
      Depth := DepthDown + DepthUp
    else
      Depth := -1;
  if (Depth = -1) or (Depth > MaxDepth) then
    raise Exception.CreateFmt( 'TCryptographicLibrarys cannot chain more than %d deep.', [MaxDepth]);
  W := self;
  isCircular := False;
  for j := 0 to MaxDepth do
    begin
    if not assigned( W) then break;
    isCircular := W = Value;
    if isCircular then break;
    W := W.FAffliateParent
    end;
  if isCircular then
    raise Exception.Create( 'Circular TCryptographicLibrary chaining is prohibited.');
  end;

if assigned( FAffliateParent) then
  begin
  FAffliateParent.RemoveFreeNotification( self);
  FAffliateParent.FAfflicates.Remove( self);
  FAffliateParent := nil
  end;

FAffliateParent := Value;

if assigned( FAffliateParent) then
  begin
  FAffliateParent.FreeNotification( self);
  if FAffliateParent.FAfflicates.IndexOf( self) = -1 then
     FAffliateParent.FAfflicates.Add( self)
  end;

end;


procedure TCryptographicLibrary.Notification(
  AComponent: TComponent; Operation: TOperation);
begin
inherited;
if Operation = opRemove then
  begin
  if AComponent = FAffliateParent then
      SetAffliateParent( nil);

  if FAfflicates.IndexOf( AComponent) <> -1 then
    (AComponent as TCryptographicLibrary).SetAffliateParent( nil)
  end;
end;


{ TCryptLibStrings }

constructor TCryptLibStrings.Create(
  Ref1: TCryptoLibStringRef; Lib1: TCryptographicLibrary);
var
  ParentRef: ^TStrings;
begin
FReference := Ref1;
FLib := Lib1;
FisDestroying := False;
ParentRef := nil;
if assigned( FLib) then
  case FReference of
    cStreamId:     ParentRef := @ FLib.FStreamCiphers_ByProgId;
    sStreamName:   ParentRef := @ FLib.FStreamCiphers_ByDisplayName;
    cBlockId:      ParentRef := @ FLib.FBlockCiphers_ByProgId;
    cBlockName:    ParentRef := @ FLib.FBlockCiphers_ByDisplayName;
    cChainId:      ParentRef := @ FLib.FChainModes_ByProgId;
    cChainName:    ParentRef := @ FLib.FChainModes_ByDisplayName;
    cHashId:       ParentRef := @ FLib.FHashs_ByProgId;
    cHashName:     ParentRef := @ FLib.FHashs_ByDisplayName;
  end;
if ParentRef^ = nil then
  ParentRef^ := self
end;

procedure TCryptLibStrings.Clear;
begin
end;


procedure TCryptLibStrings.Delete( Index: Integer);
begin
end;


destructor TCryptLibStrings.Destroy;
var
  ParentRef: ^TStrings;
begin
FisDestroying := True;
ParentRef := nil;
if assigned( FLib) then
  case FReference of
    cStreamId:     ParentRef := @ FLib.FStreamCiphers_ByProgId;
    sStreamName:   ParentRef := @ FLib.FStreamCiphers_ByDisplayName;
    cBlockId:      ParentRef := @ FLib.FBlockCiphers_ByProgId;
    cBlockName:    ParentRef := @ FLib.FBlockCiphers_ByDisplayName;
    cChainId:      ParentRef := @ FLib.FChainModes_ByProgId;
    cChainName:    ParentRef := @ FLib.FChainModes_ByDisplayName;
    cHashId:       ParentRef := @ FLib.FHashs_ByProgId;
    cHashName:     ParentRef := @ FLib.FHashs_ByDisplayName;
  end;
if ParentRef^ = self then
  ParentRef^ := nil;
inherited
end;


function TCryptLibStrings.Get( Index: Integer): string;
begin
result := '';
if assigned( FLib) then
  case FReference of
    cStreamId:     result := (FLib.FStreamCiphers[ Index] as IStreamCipher).ProgId;
    sStreamName:   result := (FLib.FStreamCiphers[ Index] as IStreamCipher      ).DisplayName;
    cBlockId:      result := (FLib.FBlockCiphers [ Index] as IBlockCipher       ).ProgId;
    cBlockName:    result := (FLib.FBlockCiphers [ Index] as IBlockCipher       ).DisplayName;
    cChainId:      result := (FLib.FChainModes   [ Index] as IBlockChainingModel).ProgId;
    cChainName:    result := (FLib.FChainModes   [ Index] as IBlockChainingModel).DisplayName;
    cHashId:       result := (FLib.FHashes       [ Index] as IHash              ).ProgId;
    cHashName:     result := (FLib.FHashes       [ Index] as IHash              ).DisplayName;
  end
end;



function TCryptLibStrings.GetCount: Integer;
begin
result := 0;
if assigned( FLib) then
  case FReference of
    cStreamId,
    sStreamName:   result := FLib.FStreamCiphers.Count;
    cBlockId,
    cBlockName:    result := FLib.FBlockCiphers.Count;
    cChainId,
    cChainName:    result := FLib.FChainModes.Count;
    cHashId,
    cHashName:     result := FLib.FHashes.Count;
  end
end;



procedure TCryptLibStrings.Insert( Index: Integer; const S: string);
begin
end;

end.
